home *** CD-ROM | disk | FTP | other *** search
/ TestDrive Windows 1993 Fall / TestDrive Windows 1993 Fall.iso / dbase / samples / cust.prg < prev    next >
Encoding:
Text File  |  1993-03-09  |  9.2 KB  |  272 lines
  1. ******************************************************************************
  2. * PROGRAM NAME: CUST.PRG
  3. *               CUSTOMER DATABASE SCREEN
  4. *               SAMPLE BUSINESS APPLICATION PROGRAM
  5. * LAST CHANGED: 09/25/89 09:26AM
  6. * WRITTEN BY:   Borland International Inc.
  7. ******************************************************************************
  8. *       FILES USED:
  9. *       Database file =  Cust.dbf   (Customer file)
  10. *       Index file    =  Cust.mdx
  11. *           TAG: Cust =  cust_id  <= Master index
  12. *       External procedure file = Library.prg
  13. ******************************************************************************
  14. * Main procedure
  15. PROCEDURE Cust
  16.  
  17.    * Link to external procedure file of "tool" procedures
  18.    SET PROCEDURE TO Library
  19.  
  20.    * Set up database environment
  21.    DO Set_env
  22.  
  23.    SET COLOR TO &c_standard.
  24.  
  25.    * Declare variables used:
  26.    * Database memory variables
  27.    STORE "" TO cust_id, category, customer, address1, address2, city, state
  28.    STORE "" TO zip, phone, contact, phone_cont, phone_ext, date_last, terms
  29.    STORE "" TO comments
  30.  
  31.    * Miscellaneous variables - used to pass parameters to Library
  32.    STORE "CUST" TO dbf, mlist         && Standard report & mail list available
  33.    STORE "N/A"  TO cust_rpt           && No custom reports available
  34.    STORE "m->cust_id" TO key, key1
  35.    STORE "NONE" TO key2, key3
  36.    keyname1 = "Customer #:"
  37.    STORE "" TO keyname2, keyname3, mcategory, mcity, mstate,mzip,mterms
  38.    list_flds = "CUST_ID, CONTACT, PHONE_CONT, PHONE_EXT"
  39.  
  40.    * Open database files and choose active indexes
  41.    SELECT 1
  42.    USE Cust ORDER Cust_id
  43.    GO TOP
  44.    * Used for area code lookup
  45.    USE Codes ORDER City IN 2
  46.  
  47.    record_num = RECNO()
  48.    * Load initial record from database into memory variables
  49.    DO Load_fld
  50.  
  51.    * Show data screen
  52.    CLEAR
  53.    DO Dstatus
  54.    DO Backgrnd
  55.    DO Show_data
  56.  
  57.    DO Bar_def            && Define popup menus
  58.  
  59.    * Activate main popup menu - execute user choices
  60.    SET COLOR TO &c_popup.
  61.    ACTIVATE POPUP main_mnu
  62.    DO Sub_ret
  63.    *
  64. RETURN
  65.  
  66.  
  67. *  UTILITY PROCEDURES (Proprietary to Cust.prg)
  68.  
  69. PROCEDURE Filter
  70.   * Filter (group) data into subset
  71.   * Select subset to set up filter condition  (Y=turn on, N=abort selection, 
  72.   * T=turn off) If filter is already on, set default choice to T, show 
  73.   * window. If filter is not on, set default choice to Y, show window. 
  74.   choice = IIF(filters_on,"T","Y")
  75.   DO Filt_ans
  76.   IF choice = "Y"
  77.      * Start process of choosing filter condition
  78.      mcategory = SPACE(15)
  79.      mcity     = SPACE(20)
  80.      mstate    = SPACE(2)
  81.      STORE SPACE(10) TO mzip, mterms
  82.      ACTIVATE WINDOW alert
  83.         * Get user's filter condition selection(s)
  84.         @  0, 0 SAY "--------- ENTER FILTER CONDITION --------"
  85.         @  1, 0 SAY "CATEGORY:" GET mcategory FUNCTION "!" ;
  86.            MESSAGE "Enter a customer category"
  87.         @  2, 0 SAY "CITY:    " GET mcity     PICTURE "!XXXXXXXXXXXXXXXXXXX"
  88.         @  3, 0 SAY "STATE:   " GET mstate    PICTURE  "!!"
  89.         @  3,15 SAY "ZIP: "     GET mzip
  90.         @  4, 0 SAY "TERMS:   " GET mterms    FUNCTION "!"
  91.         @  5, 0 SAY "Enter one or more filter conditions"
  92.         READ
  93.     DEACTIVATE WINDOW alert
  94.     subset = " "          && Initialize filter condition variable to null
  95.     * Process user's entries to build filter condition
  96.     mcategory = TRIM(mcategory)
  97.     mcity   = UPPER(TRIM(mcity))
  98.     mstate  = TRIM(mstate)
  99.     mzip    = TRIM(mzip)
  100.     mterms  = TRIM(mterms)
  101.     subset  = subset + IIF("" <> mcategory, ;
  102.               [category = mcategory .AND. ], "")
  103.     subset  = subset + IIF("" <> mcity, ;
  104.               [UPPER(TRIM(city)) = mcity .AND. ], "")
  105.     subset  = subset + IIF("" <> mstate, ;
  106.               [state = mstate .AND. ], "")
  107.     subset  = subset + IIF("" <> mzip, ;
  108.               [zip = mzip .AND. ], "")
  109.     subset  = subset + IIF("" <> mterms, ;
  110.               [terms = mterms .AND. ], "")
  111.     *
  112.     IF "" = TRIM(subset)    && Check whether data entered into subset string
  113.        DO Warnbell
  114.        filters_on = .F.
  115.     ELSE
  116.        * If string is not empty, truncate the .AND. from end of subset string
  117.        subset = SUBSTR(subset,1,LEN(subset)-6)
  118.        SET FILTER TO &subset.     && Filter on entered filter string condition
  119.        GO TOP                     && Activate filter by moving record pointer
  120.        * Check whether filter condition matches any records (no match=EOF)
  121.        filters_on = .NOT. EOF()   && Filter is turned on if .T. 
  122.        IF .NOT. filters_on        && Turn off filter if no matches found
  123.           DO Warnbell
  124.           DO Show_msg WITH "No Customer records match the filter condition"
  125.           SET FILTER TO
  126.           GO record_num
  127.        ENDIF
  128.     ENDIF
  129.   ELSE
  130.       IF choice = "T"
  131.          * If user selects "T", turn off filter
  132.          SET FILTER TO
  133.          filters_on = .F.
  134.       ENDIF
  135.   ENDIF
  136. RETURN
  137.  
  138. PROCEDURE Indexer
  139.    * Create/rebuild index
  140.    INDEX ON cust_id TAG Cust_id
  141.    GO TOP
  142. RETURN
  143.  
  144. PROCEDURE Init_fld
  145.    * Initialize memory variable values for data entry
  146.    STORE SPACE(30) TO customer, address1
  147.    STORE SPACE(20) TO city, contact, comments
  148.    STORE SPACE(10) TO zip, terms
  149.    STORE SPACE(13) TO phone, phone_cont
  150.    state     = "TX"                     && Could be any state or blank
  151.    cust_id   = SPACE(6)
  152.    category  = SPACE(15)
  153.    address2  = SPACE(25)
  154.    phone_ext = SPACE(4)
  155.    date_last = { / / }
  156. RETURN
  157.  
  158. PROCEDURE Load_fld
  159.    * Load field values from Cust database record into memory variables
  160.    cust_id    = cust_id
  161.    category   = category
  162.    customer   = customer
  163.    address1   = address1
  164.    address2   = address2
  165.    city       = city
  166.    state      = state
  167.    zip        = zip
  168.    phone      = phone
  169.    contact    = contact
  170.    phone_cont = phone_cont
  171.    phone_ext  = phone_ext
  172.    date_last  = date_last
  173.    terms      = terms
  174.    comments   = comments
  175. RETURN
  176.  
  177. PROCEDURE Repl_fld
  178.    * Replace database fields with values of current memory variables
  179.    REPLACE cust_id WITH m->cust_id, category WITH m->category, ;
  180.            customer WITH m->customer,address1 WITH m->address1, ;
  181.            address2 WITH m->address2,city WITH m->city, state WITH m->state
  182.    REPLACE zip WITH m->zip, phone WITH m->phone,;
  183.            contact WITH m->contact,phone_cont WITH m->phone_cont,;
  184.            phone_ext WITH m->phone_ext,date_last WITH m->date_last, ;
  185.            terms WITH m->terms,comments WITH m->comments
  186. RETURN
  187.  
  188. PROCEDURE Backgrnd
  189.    * Display background screen
  190.    * Draw and fill in boxes
  191.    @  1,18 TO  3,41 DOUBLE COLOR &c_blue.
  192.    @  5, 2 TO  7,56 DOUBLE COLOR &c_red.
  193.    @  2,19 FILL TO  2,40   COLOR &c_blue.
  194.    @  6, 3 FILL TO  6,55   COLOR &c_red.
  195.    @  9, 3 FILL TO 19,55   COLOR &c_red.
  196.    @ 15, 2 TO 15,56        COLOR &c_red.
  197.    @  8, 2 TO 20,56        COLOR &c_red.
  198.    SET COLOR TO &c_data.
  199.    @  2,20 SAY "CUSTOMER  DATABASE"
  200.    @  6, 4 SAY "CUSTOMER NO:"
  201.    @  6,30 SAY "CATEGORY:"
  202.    @  9, 4 SAY "NAME:"
  203.    @ 10, 4 SAY "ADDRESS:"
  204.    @ 12, 4 SAY "CITY:"
  205.    @ 13, 4 SAY "STATE:"
  206.    @ 13,16 SAY "ZIP:"
  207.    @ 14, 4 SAY "PHONE:"
  208.    @ 16, 4 SAY "CONTACT:"
  209.    @ 17, 4 SAY "PHONE:"
  210.    @ 17,27 SAY "EXTENSION:"
  211.    @ 18, 4 SAY "LAST CONTACT DATE:"
  212.    @ 19, 4 SAY "TERMS:"
  213.    @ 19,27 SAY "COMMENT:"
  214.    SET COLOR TO &c_standard.
  215. RETURN
  216.  
  217. PROCEDURE Show_data
  218.    * Display data for entry
  219.    SET COLOR TO &c_fields.
  220.    @  6,17 SAY cust_id
  221.    @  6,40 SAY category
  222.    @  9,13 SAY customer
  223.    @ 10,13 SAY address1
  224.    @ 11,13 SAY address2
  225.    @ 12,13 SAY city
  226.    @ 13,13 SAY state
  227.    @ 13,21 SAY zip
  228.    @ 14,13 SAY phone
  229.    @ 16,13 SAY contact
  230.    @ 17,13 SAY phone_cont
  231.    @ 17,38 SAY phone_ext
  232.    @ 18,23 SAY date_last
  233.    @ 19,13 SAY terms
  234.    @ 19,36 SAY comments
  235.    SET COLOR TO &c_standard.
  236. RETURN
  237.  
  238. PROCEDURE Get_data
  239.    * Display data for entry
  240.    SET COLOR TO &c_data.
  241.    @  6,17 GET m->cust_id   PICTURE  "!99999" ;
  242.            VALID Duplicat(&key.) ;
  243.            ERROR "Invalid customer ID number; please re-enter" ;
  244.            MESSAGE "Enter a six digit customer ID beginning " + ;
  245.                    "with a letter, or Esc to quit"
  246.    @  6,40 GET m->category ;
  247.            PICTURE "@M ARCHITECTS, CONSULTANTS, CONTRACTORS, LEGAL" ;
  248.            MESSAGE "Press spacebar for Category choices"
  249.    @  9,13 GET m->customer  FUNCTION "!" ;
  250.            MESSAGE "Enter name of customer"
  251.    @ 10,13 GET m->address1
  252.    @ 11,13 GET m->address2
  253.    @ 12,13 GET m->city       PICTURE "!XXXXXXXXXXXXX"
  254.    @ 13,13 GET m->state      PICTURE  "!!"
  255.    @ 13,21 GET m->zip
  256.    @ 14,13 GET m->phone      PICTURE  "(999)999-9999"
  257.    @ 16,13 GET m->contact    FUNCTION "!" ;
  258.            MESSAGE "Enter name of contact"
  259.    @ 17,13 GET m->phone_cont PICTURE "(999)999-9999"
  260.    @ 17,38 GET m->phone_ext  PICTURE "9999" ;
  261.            MESSAGE "Enter phone extension"
  262.    @ 18,23 GET m->date_last  FUNCTION "D" ;
  263.            MESSAGE "Enter date that customer was last contacted"
  264.    @ 19,13 GET m->terms      PICTURE "@M CASH, NET 30, NET 45" ;
  265.            MESSAGE "Press spacebar to see Terms choices"
  266.    @ 19,36 GET m->comments   FUNCTION "!" ;
  267.            MESSAGE "Enter any comments"
  268.    SET COLOR TO &c_standard.
  269.    ON KEY LABEL F9 DO Findcode WITH m->city
  270. RETURN
  271. ********************************  END OF CUST.PRG ****************************
  272.